home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / sndpas.zip / SOUNDER.PAS < prev   
Pascal/Delphi Source File  |  1992-12-22  |  9KB  |  288 lines
  1. {Sound generation and timing interrupt
  2.  
  3. Written by:
  4.  
  5.     Nels Anderson
  6.    92 Bishop Drive
  7. Framingham, MA  01701
  8.  
  9. Released to the public domain
  10. }
  11.  
  12. unit Sounder;
  13.  
  14. interface
  15.  
  16. Uses
  17.   Crt;
  18.  
  19. procedure StartSound(Notes:  POINTER; Repeats:  INTEGER; Speed:  BYTE);
  20.  
  21. const
  22.  
  23. { Notes Values:
  24.  
  25.   Use these constants to get the proper values for notes.  The first
  26.   character is the note name, S indicates a sharp, and the final number
  27.   indicates the octave.}
  28.  
  29.   CN3 = 13;
  30.   CS3 = 14;
  31.   DN3 = 15;
  32.   DS3 = 16;
  33.   EN3 = 16;
  34.   FN3 = 17;
  35.   FS3 = 19;
  36.   GN3 = 20;
  37.   GS3 = 21;
  38.   AN3 = 22;
  39.   AS3 = 23;
  40.   BN3 = 25;
  41.   CN4 = 26;
  42.   CS4 = 28;
  43.   DN4 = 29;
  44.   DS4 = 31;
  45.   EF4 = 31;
  46.   EN4 = 33;
  47.   FF4 = 33; {?}
  48.   FN4 = 35;
  49.   FS4 = 37;
  50.   GN4 = 39;
  51.   GS4 = 42;
  52.   AF4 = 42;
  53.   AN4 = 44;
  54.   AS4 = 47;
  55.   BF4 = 47;
  56.   BN4 = 49;
  57.   CN5 = 52;
  58.   CS5 = 55;
  59.   DF5 = 55;
  60.   DN5 = 59;
  61.   DS5 = 62;
  62.   EN5 = 66;
  63.   FN5 = 70;
  64.   FS5 = 74;
  65.   GN5 = 78;
  66.   GS5 = 83;
  67.   AF5 = 83;
  68.   AN5 = 88;
  69.   AS5 = 93;
  70.   BF5 = 93;
  71.   BN5 = 99;
  72.   CN6 = 105;
  73.   CS6 = 111;
  74.   DN6 = 117;
  75.   DS6 = 124;
  76.   EN6 = 133;
  77.   FN6 = 140;
  78.   FS6 = 148;
  79.   GN6 = 157;
  80.   GS6 = 166;
  81.   AN6 = 176;
  82.   AS6 = 186;
  83.   BN6 = 198;
  84.   CN7 = 209;
  85.   CS7 = 222;
  86.   DN7 = 235;
  87.   DS7 = 249;
  88.  
  89. { Sound Collection:
  90.  
  91.   Each sound is an array of pairs of bytes, where the first byte of each
  92.   pair is the duration in 1/18th second units and the second byte of the
  93.   pair is the note frequency in 10's of Hertz.  To use a sound, include
  94.   a command like the following in a program:
  95.  
  96.            StartSound(@PhaserSound,3,1);    {do phaser sound 3 times}
  97.  
  98.   Ruddigore: array[1..411] of BYTE = (        {theme song}
  99.   36,000,
  100.   3,DN4,1,DN4, 2,DN4,2,DN4,8,FN4,4,DN4,
  101.   2,DN4,2,DN4,8,AN4,3,AN4,1,AN4,
  102.   4,DN5,2,AN4,2,AN4,4,AN4,4,BN4, 12,CN5,4,CN4,
  103.   2,CN4,2,CN4,8,EN4,2,CN4,2,CN4,
  104.   2,CN4,2,CN4,8,GN4,4,CN4, 4,CN5,2,CN5,2,CN5,2,CN5,2,DF5,4,BF4,
  105.   12,AF4,3,AF4,1,AF4,
  106.   4,FF4,4,FF4,6,AF4,2,FF4, 4,EF4,4,EF4,6,AF4,2,AF4,
  107.   4,FF4,4,FF4,4,AF4,2,AF4,2,AF4, 12,BN4,4,EN4,
  108.   4,AN4,4,AN4,4,AN4,2,BN4,2,CS5,
  109.   4,DN5,4,AN4,4,FN4,4,DN4, 4,AN4,4,AN4,4,AN4,2,BN4,2,CS5,
  110.   6,DN5,2,FN5,4,FN5,4,DN5, 4,DN5,2,DN5,2,DN5,4,CS5,4,CS5,
  111.   6,DN5,2,FN5,4,FN5,4,DN5, 4,DN5,4,CS5,4,CN5,4,AF4,
  112.   4,CN5,4,BN4,4,BF4,4,GN4, 4,CS5,4,AN4,4,FS4,4,FN3,
  113.   8,AN4,8,AN3, 8,DN4,8,000,
  114.  
  115.   3,DN4,1,DN4, 2,DN4,2,DN4,8,FN4,4,DN4,
  116.   2,DN4,2,DN4,8,AN4,3,AN4,1,AN4,
  117.   4,DN5,2,AN4,2,AN4,4,AN4,4,BN4, 12,CN5,4,CN4,
  118.   2,CN4,2,CN4,8,EN4,2,CN4,2,CN4,
  119.   2,CN4,2,CN4,8,GN4,4,CN4, 4,CN5,2,CN5,2,CN5,2,CN5,2,DF5,4,BF4,
  120.   12,AF4,3,AF4,1,AF4,
  121.   4,FF4,4,FF4,6,AF4,2,FF4, 4,EF4,4,EF4,6,AF4,2,AF4,
  122.   4,FF4,4,FF4,4,AF4,2,AF4,2,AF4, 12,BN4,4,EN4,
  123.   4,AN4,4,AN4,4,AN4,2,BN4,2,CS5,
  124.   4,DN5,4,AN4,4,FN4,4,DN4, 4,AN4,4,AN4,4,AN4,2,BN4,2,CS5,
  125.   6,DN5,2,FN5,4,FN5,4,DN5, 4,DN5,2,DN5,2,DN5,4,CS5,4,CS5,
  126.   6,DN5,2,FN5,4,FN5,4,DN5, 4,DN5,4,CS5,4,CN5,4,AF4,
  127.   4,CN5,4,BN4,4,BF4,4,GN4, 4,CS5,4,AN4,4,FS4,4,FN3,
  128.   8,AN4,8,AN3,
  129.   4,DN4,2,000,2,GN3,4,DN4,2,000,2,GN3,
  130.   4,DN4,2,000,2,GN3,2,DN4,2,GN3,2,DN4,2,GN3,
  131.   4,DN4,4,000,4,DN4,4,000, 16,DN4,0);
  132.  
  133.   Canon: array[1..639] of BYTE = (
  134.   36,000,
  135.   4,000,4,FS5,4,EN5,4,DN5, 4,EN5,4,DN5,4,CS5,8,BN4,    {1-2}
  136.   4,FS5,4,EN5,4,DN5,4,DN5, 4,CS5,4,BN4,4,AN4,4,CS5,    {3-4}
  137.   4,000,4,BN5,4,AN5,4,GN5, 8,AN5,4,BN5,4,CS6,        {5-6}
  138.   8,DN6,8,BN5, 4,FS5,4,EN5,4,FS5,2,AN4,2,GN4,        {7-8}
  139.   4,FS5,4,EN5,4,FS5,4,AN5, 8,FS5,4,FS5,4,EN5,        {9-10}
  140.   4,DN5,2,DN5,2,EN5,4,FS5,4,BN5, 8,BN5,4,000,4,AN5,    {11-12}
  141.   4,GN5,2,FS5,2,EN5,4,DN5,4,EN4, 4,FS4,4,000,4,DN5,4,FS4,
  142.   4,GN4,4,DN5,4,EN5,4,DN5, 2,CS5,2,BN4,8,AN4,4,000,    {15-16}
  143.   2,FS4,2,AN4,2,FS4,2,AN4,2,FS4,2,AN4,2,FS4,2,AN4,    {17}
  144.   2,EN4,2,AN4,2,EN4,2,AN4,2,EN4,2,AN4,2,EN4,2,AN4,    {18}
  145.   2,FS4,2,BN4,2,FS4,2,BN4,2,FS4,2,BN4,2,FS4,2,AN4,    {19}
  146.   2,AN4,2,CS5,2,FS5,2,GN5,2,FS5,2,DN5,2,AN4,2,CS5,    {20}
  147.   2,AN4,4,DN5,4,GN5,2,DN5,2,CS5,2,BN4,            {21}
  148.   2,DN5,2,CS5,8,DN5,4,DN5,                {22}
  149.   2,DN4,2,BN4,2,CS5,2,BN4,4,DN5,2,EN5,2,DN5,        {23}
  150.   2,CS5,2,BN4,8,AN4,2,EN4,2,AN4,            {24}
  151.   4,FS5,4,DN5,4,FS4,4,FS5,                {25}
  152.   4,EN5,4,AN4,1,EN5,1,FS5,1,EN5,1,FS5,1,EN5,1,FS5,2,EN5,
  153.   4,DN5,4,BN4,4,FS4,4,DN5,                {27}
  154.   4,CS5,4,AN4,1,CS5,1,DN5,1,CS5,1,DN5,1,CS5,1,BN4,2,CS5,{28}
  155.   4,BN4,4,DN5,4,BN4,4,GN4,                {29}
  156.   1,FS4,1,AN4,1,DN5,1,FS5,1,AN4,1,DN5,1,FS5,1,AN5,    {30}
  157.   1,DN5,1,FS5,1,AN5,1,BN5,1,AN5,1,GN5,1,FS5,1,EN5,
  158.   4,DN5,4,BN4,2,GN4,2,BN4,2,CS5,2,DN5,            {31}
  159.   4,CS5,4,EN5,1,AN5,1,BN5,1,AN5,1,BN5,1,AN5,1,BN5,2,GN5,{32}
  160.   1,FS5,1,EN5,1,DN5,1,AN4,1,FS4,1,EN4,1,BN4,1,AN3,    {33}
  161.   1,DN6,1,GN5,1,FS5,1,DN5,1,AN4,1,GN4,1,FS4,1,DN4,
  162.   1,EN5,1,DN5,1,CS5,1,BN4,1,CS5,1,GN4,1,FS4,1,EN4,    {34}
  163.   1,GN5,1,FS5,1,EN5,1,DN5,1,CS5,1,BN4,1,AN4,1,GN4,
  164.   1,DN5,1,CS5,1,BN4,1,FS4,1,DN4,1,CS4,1,BN3,1,FS3,    {35}
  165.   1,BN5,1,EN5,1,DN5,1,CS5,1,BN4,1,AN4,1,GN4,1,FS4,
  166.   1,CS5,1,BN4,1,AN4,1,GN4,1,AN4,1,EN4,1,DN4,1,CS4,    {36}
  167.   1,AN5,1,GN5,1,FS5,1,EN5,1,DN5,1,CS5,1,BN4,1,AN4,
  168.   1,BN4,1,AN4,1,GN4,1,FS4,1,FS4,1,DN4,1,CS4,1,BN3,    {37}
  169.   1,GN4,1,BN4,1,CS5,1,DN5,1,GN5,1,AN5,1,BN5,1,DN6,
  170.   1,FS6,1,EN6,1,DN6,1,AN5,1,FS5,1,EN5,1,DN5,1,AN4,    {38}
  171.   1,DN5,1,EN5,1,FS5,1,GN5,1,AN5,1,BN5,1,CS6,1,DN6,
  172.   1,GN5,1,FS5,1,EN5,1,DN5,1,CS5,1,BN4,1,AN4,1,GN4,    {39}
  173.   1,BN5,1,AN5,1,GN5,1,FS5,1,EN5,1,DN5,1,CS5,1,BN4,
  174.   1,CS6,1,BN5,1,AN5,1,GN5,1,FS5,1,EN5,1,DN5,1,CS5,    {40}
  175.   1,AN4,1,GN4,1,FS4,1,EN4,1,DN4,1,CS4,1,BN3,1,AN3,
  176.   8,DN5,8,AN4, 8,CS5,8,AN4, 8,BF4,8,FN4,
  177.   8,BF4,4,000,4,BF4, 8,BF4,8,AN4, 16,AN4,16,DN5,0);
  178.  
  179.   PhaserSound: array[1..5] of BYTE = (
  180.   1,30,1,31,0);
  181.   TorpSound: array[1..13] of BYTE = (
  182.   1,8,1,9,1,8,1,20,1,21,1,22,0);
  183.   WhistleSound: array[1..5] of BYTE = (
  184.   4,50,10,100,0);
  185. Type
  186.   {
  187.     You must modify the number 639 below so that
  188.     it equals the number of cells in the biggest
  189.     array of the Sound Collection constants above.
  190.   }
  191.  
  192.   ByteArray = array[1..639] of BYTE;
  193. Var
  194.   SoundSpeed:  BYTE;        {multiplier used to slow down sounds}
  195.   SoundCount:  BYTE;        {counts how long current sound has been on}
  196.   MySound: ^ByteArray;        {points to array of notes and durations}
  197.   New1CInt,            {address of new interrupt}
  198.   Int1CSave:  POINTER;        {saves original $1C interrupt}
  199.   NumRepeats,            {number of times to repeat sound}
  200.   MyClock,            {general purpose timer}
  201.   SoundOff:  INTEGER;        {offset into note array}
  202.   SndFlg,            {set when sounds allowed}
  203.   MakeSound:  BOOLEAN;        {set while sound is going}
  204.  
  205. implementation
  206.  
  207. procedure StartSound(Notes:  POINTER; Repeats:  INTEGER; Speed:  BYTE);
  208. { Start generating the sound pointed to by Notes }
  209. begin
  210.   SoundSpeed := Speed;            {set speed}
  211.   SoundOff := 1;            {offset into sound array}
  212.   SoundCount := 1;            {counter for current note}
  213.   MySound := Notes;            {pointer to sound array}
  214.   MakeSound := TRUE;            {enable sounds}
  215.   NumRepeats := Repeats;        {number times to repeat sound}
  216. end; {StartSound procedure}
  217.  
  218. procedure TimerInt;
  219. interrupt;
  220. { Clock tick interrupt
  221.  
  222. BIOS interrupt $1C has been replaced with the following routine.  This
  223. interrupt occurs on each clock tick (18 per second).
  224.  
  225. The interrupt mainly handles sounds.  When the MakeSound flag is true,
  226. the pointer MySound must be pointing to a byte array containing durations
  227. and frequencies of sounds to be generated.  Sounds will be generated from
  228. the array until a duration of 0 is found.
  229.  
  230. A general purpose timer is also incremented each time the interrupt
  231. occurs.
  232.  
  233. To use the interrupt, the main program needs to do the following:
  234.  
  235. Begin
  236.   GetIntVec($1C,Int1CSave);        (save original interrupt vector)
  237.   SetIntVec($1C,New1CInt);        (install timer interrupt)
  238.           .
  239.           .                (body of program)
  240.           .
  241.   StartSound(@PhaserSound,3,1);        (phaser sound 3 times, normal speed)
  242.           .
  243.           .                (body of program)
  244.           .
  245.   SetIntVec($1C,Int1CSave);        (restore original 1C interrupt)
  246. end.
  247. }
  248. begin
  249.   Inc(MyClock);                    {increment timer}
  250.   if not SndFlg then begin            {exit if sounds turned off}
  251.     MakeSound := FALSE;
  252.     Exit;
  253.   end;
  254.   if MakeSound then begin            {if making a sound...}
  255.     Dec(SoundCount);
  256.     if SoundCount <= 0 then begin        {if current sound done...}
  257.       NoSound;
  258.       SoundCount := SoundSpeed * MySound^[SoundOff];{get duration of next one}
  259.       if SoundCount > 0 then begin        {if there is a next one...}
  260.         Inc(SoundOff);
  261.         Sound(10*MySound^[SoundOff]);        {start it up}
  262.         Inc(SoundOff);
  263.       end
  264.       else begin                {if end of sound array...}
  265.         Dec(NumRepeats);            {decrement number of repeats}
  266.         if NumRepeats > 0 then begin        {if we must repeat...}
  267.           SoundOff := 3;            {reset offset into array}
  268.           SoundCount := MySound^[1];        {get duration of first note}
  269.           Sound(10*MySound^[2]);        {start it up}
  270.         end
  271.         else begin                {if all repeats now done...}
  272.           NoSound;                {stop all sound}
  273.           MakeSound := FALSE;            {reset flag}
  274.         end;
  275.       end;
  276.     end; {if SoundCount = 0}
  277.   end; {if making a sound}
  278. end; {TimerInt interrupt procedure}
  279.  
  280. begin
  281.  
  282.   SndFlg := TRUE;                {sounds are allowed}
  283.   MakeSound := FALSE;                {sound initially off}
  284.   MyClock := 0;                    {reset timer}
  285.   New1CInt := @TimerInt;            {get address of interrupt}
  286.  
  287. end.
  288.